home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / telecomm / fido / pltext05.lha / PluText.lst < prev    next >
Encoding:
File List  |  1994-08-03  |  11.8 KB  |  570 lines
  1. '
  2. ' PluText- Quick summary of a message area
  3. '
  4. ' (c) by Peter Deane (3:622/401)
  5. '
  6. ' Whilst this program is freely distributable it is still copyright!
  7. ' Acknowledgement MUST be given in the program documentation
  8. ' for any utilisation of parts of this code in other works.
  9. '
  10. ' It must **NEVER** be sold, or had profits made from it,
  11. ' unless prior agreement (in writing) has been arranged with
  12. ' the author.
  13. '
  14. versnum$="$VER: 0.5 "
  15. versnum$="0.5"
  16. versdate$="02-Aug-94"
  17. versname$="PluText"
  18. '
  19. cline$=TRIM$(_dosCmd$)
  20. IF cline$=""
  21.   cline$="Mail:"
  22. ENDIF
  23. '
  24. OPENW #0
  25. ~ActivateWindow(WINDOW(0))
  26. '
  27. PRINT versname$+" - V"+versnum$+" ("+versdate$+")  By Peter Deane, 3:622/401"
  28. '
  29. PRINT "Please select a *.Msg directory name"
  30. PRINT
  31. '
  32. pickdir:
  33. '
  34. FILESELECT "*.Msg Dir","DIR",cline$,src$
  35. '
  36. IF NOT EXIST(src$)
  37.   PRINT "Directory specified doesn't exist!"
  38.   GOTO pickdir
  39. ENDIF
  40. '
  41. IF LEN(src$)>1
  42.   IF RIGHT$(src$,1)<>"/" AND RIGHT$(src$,1)<>":"
  43.     src$=src$+"/"
  44.   ENDIF
  45. ELSE
  46.   src$=""
  47. ENDIF
  48. '
  49. sourcedir$=src$
  50. '
  51. IF (sourcedir$="") OR (NOT EXIST(sourcedir$))
  52.   PRINT
  53.   PRINT "Error - specified directory does not exist."
  54.   PRINT
  55.   PRINT "Usage: "+versname$+" [MailPath]"
  56.   GOTO finishup
  57. ENDIF
  58. '
  59. PRINT
  60. PRINT "Scanning source dir..";
  61. @getwhatshere(sourcedir$)
  62. PRINT "...done!"
  63. '
  64. PRINT
  65. PRINT
  66. PRINT "Lowater: ";lowater%
  67. PRINT
  68. PRINT "Hiwater: ";hiwater%
  69. PRINT
  70. PRINT
  71. '
  72. aa$=STR$(lowater%)
  73. PRINT "Start at Msg No: ";
  74. FORM INPUT 6 AS aa$
  75. '
  76. xx%=VAL(aa$)
  77. IF xx%<lowater%
  78.   xx%=lowater%
  79. ENDIF
  80. IF xx%>hiwater%
  81.   xx%=hiwater%
  82. ENDIF
  83. lowater%=xx%
  84. '
  85. '
  86. aa$=STR$(hiwater%)
  87. PRINT "End at Msg No: ";
  88. FORM INPUT 6 AS aa$
  89. '
  90. xx%=VAL(aa$)
  91. IF xx%>hiwater%
  92.   xx%=hiwater%
  93. ENDIF
  94. IF xx%<lowater%
  95.   xx%=lowater%
  96. ENDIF
  97. '
  98. hiwater%=xx%
  99. '
  100. '
  101. PRINT
  102. PRINT
  103. PRINT
  104. PRINT
  105. PRINT
  106. PRINT "PluText can produce three types of output:"
  107. PRINT
  108. PRINT "One-line Header Summary"
  109. PRINT "All Messages->ASCII"
  110. PRINT "Bad_Mail summary of AREA lines"
  111. PRINT
  112. ALERT 0,"What type of text?",1,"OneLine|AllMsgs|BadSum",sumtype%
  113. '
  114. grabfile:
  115. PRINT
  116. PRINT "Now enter the filename for the output text file"
  117. PRINT
  118. '
  119. FILESELECT "Output File","CREATE","RAM:OneLine.txt",create$
  120. '
  121. IF EXIST(create$)
  122.   ALERT 0,create$+" exists|Overwrite?",2,"OverWrite|ReSelect",dotype%
  123.   IF dotype%=2
  124.     GOTO grabfile
  125.   ENDIF
  126. ENDIF
  127. '
  128. OPEN "O",#2,create$,2048
  129. '
  130. IF sumtype%=1
  131.   '
  132.   PRINT "----- ---------------- ---------------- -------------------- --------- -----"
  133.   PRINT "Msg # From             To               Subject              Date      Attrs"
  134.   PRINT "----- ---------------- ---------------- -------------------- --------- -----"
  135.   PRINT #2,"----- ---------------- ---------------- -------------------- --------- -----"
  136.   PRINT #2,"Msg # From             To               Subject              Date      Attrs"
  137.   PRINT #2,"----- ---------------- ---------------- -------------------- --------- -----"
  138.   '
  139.   '
  140.   FOR k%=lowater% TO hiwater%
  141.     spotl%=0
  142.     '
  143.     msghandle$=sourcedir$+STR$(k%)+".MSG"
  144.     @header_load
  145.     IF spotl%
  146.       @getmsgdetails(spotl%)
  147.       '
  148.       fromname$=LEFT$(fromname$,16)
  149.       toname$=LEFT$(toname$,16)
  150.       subject$=LEFT$(subject$,20)
  151.       att$=""
  152.       IF BTST(attribute&,0)
  153.         att$=att$+"P"
  154.       ENDIF
  155.       IF BTST(attribute&,1)
  156.         att$=att$+"C"
  157.       ENDIF
  158.       IF BTST(attribute&,2)
  159.         att$=att$+"R"
  160.       ENDIF
  161.       IF BTST(attribute&,3)
  162.         att$=att$+"S"
  163.       ENDIF
  164.       IF BTST(attribute&,4)
  165.         att$=att$+"A"
  166.       ENDIF
  167.       IF BTST(attribute&,8)
  168.         att$=att$+"L"
  169.       ENDIF
  170.       IF BTST(attribute&,9)
  171.         att$=att$+"H"
  172.       ENDIF
  173.       IF BTST(attribute&,11)
  174.         att$=att$+"F"
  175.       ENDIF
  176.       att$=LEFT$(att$,5)
  177.       '
  178.       @spaceout(STR$(k%),6)
  179.       PRINT STR$(k%)+SPACE$(spc%);
  180.       PRINT #2,STR$(k%)+SPACE$(spc%);
  181.       @spaceout(fromname$,17)
  182.       PRINT fromname$+SPACE$(spc%);
  183.       PRINT #2,fromname$+SPACE$(spc%);
  184.       @spaceout(toname$,17)
  185.       PRINT toname$+SPACE$(spc%);
  186.       PRINT #2,toname$+SPACE$(spc%);
  187.       @spaceout(subject$,21)
  188.       PRINT subject$+SPACE$(spc%);
  189.       PRINT #2,subject$+SPACE$(spc%);
  190.       PRINT LEFT$(dattime$,10);
  191.       PRINT #2,LEFT$(dattime$,10);
  192.       PRINT att$
  193.       PRINT #2,att$
  194.       '
  195.     ENDIF
  196.     '
  197.     onelineclean:
  198.     ' better give us back the memory!
  199.     '
  200.     IF spotl%
  201.       ~FreeMem(spotl%,msglen%+4)
  202.     ENDIF
  203.     spotl%=0
  204.   NEXT k%
  205.   '
  206. ELSE IF sumtype%=2
  207.   '
  208.   '
  209.   FOR k%=lowater% TO hiwater%
  210.     spotl%=0
  211.     '
  212.     msghandle$=sourcedir$+STR$(k%)+".MSG"
  213.     @header_load
  214.     '
  215.     IF spotl%
  216.       PRINT msghandle$+" found - "+STR$(hiwater%-k%)+" to go - writing "+STR$(msglen%)+" bytes...";
  217.       @getmsgdetails(spotl%)
  218.       '
  219.       PRINT #2,""
  220.       PRINT #2,"---------------------------------------------------------------------------"
  221.       @spaceout(fromname$,36)
  222.       PRINT #2,"From: "+fromname$+SPACE$(spc%);
  223.       PRINT #2,"Message # : "+STR$(k%)+" of "+STR$(hiwater%)
  224.       @spaceout(toname$,36)
  225.       PRINT #2,"To  : "+toname$+SPACE$(spc%);
  226.       PRINT #2,"Area      : "+sourcedir$
  227.       '
  228.       @spaceout(dattime$,36)
  229.       PRINT #2,"Date: "+dattime$+SPACE$(spc%);
  230.       PRINT #2,"Replies   : ";
  231.       '
  232.       IF replyto&>0
  233.         PRINT #2,STR$(replyto&)+" <=- ";
  234.       ENDIF
  235.       PRINT #2,"*";
  236.       IF nextreply&>0
  237.         PRINT #2," -=> "+STR$(nextreply&);
  238.       ENDIF
  239.       PRINT #2,""
  240.       '
  241.       PRINT #2,"Attr:";
  242.       '
  243.       xx$=""
  244.       '
  245.       IF BTST(attribute&,0)
  246.         xx$=xx$+" PRIVT"
  247.       ENDIF
  248.       IF BTST(attribute&,1)
  249.         xx$=xx$+" CRASH"
  250.       ENDIF
  251.       IF BTST(attribute&,2)
  252.         xx$=xx$+" RECD"
  253.       ENDIF
  254.       IF BTST(attribute&,3)
  255.         xx$=xx$+" SENT"
  256.       ENDIF
  257.       IF BTST(attribute&,4)
  258.         xx$=xx$+" FATCH"
  259.       ENDIF
  260.       IF BTST(attribute&,8)
  261.         xx$=xx$+" LOCAL"
  262.       ENDIF
  263.       IF BTST(attribute&,9)
  264.         xx$=xx$+" HOLD"
  265.       ENDIF
  266.       IF BTST(attribute&,11)
  267.         xx$=xx$+" FREQ"
  268.       ENDIF
  269.       '
  270.       IF LEN(xx$)>36
  271.         xx$=LEFT$(xx$,36)
  272.       ELSE IF LEN(xx$)<=1
  273.         xx$=" "
  274.       ENDIF
  275.       @spaceout(xx$,37)
  276.       PRINT #2,xx$+SPACE$(spc%);
  277.       '
  278.       PRINT #2,"Times Read: "+STR$(timesread&)
  279.       '
  280.       xx$=STR$(origzone&)+":"+STR$(orignet&)+"/"+STR$(orignode&)+"."+STR$(origpoint&)
  281.       PRINT #2,"Orig: ";
  282.       @spaceout(xx$,36)
  283.       PRINT #2,xx$+SPACE$(spc%);
  284.       PRINT #2,"Dest'n    : ";
  285.       PRINT #2,STR$(destzone&)+":"+STR$(destnet&)+"/"+STR$(destnode&)+"."+STR$(destpoint&)
  286.       '
  287.       PRINT #2,"Subj: "+subject$
  288.       PRINT #2,"---------------------------------------------------------------------------"
  289.       '
  290.       spot2%=AllocMem(msglen%-180,65536)
  291.       '
  292.       IF spot2%=0
  293.         PRINT
  294.         PRINT "Error finding memory - we must be absolutely incredibly low!"
  295.         PRINT ""
  296.         PRINT "If we haven't got enough room for 1 message, that's it! I'm outahere!"
  297.         PRINT
  298.         GOTO msgdropexit
  299.       ENDIF
  300.       '
  301.       i%=0
  302.       FOR kr%=190 TO msglen%
  303.         xq%=PEEK(kr%+spotl%)
  304.         IF (xq%>31) AND (xq%<>141)
  305.           POKE spot2%+i%,xq%
  306.           INC i%
  307.         ENDIF
  308.         IF xq%=1
  309.           POKE spot2%+i%,1
  310.           INC i%
  311.         ENDIF
  312.         IF xq%=13
  313.           POKE spot2%+i%,0
  314.           INC i%
  315.         ENDIF
  316.       NEXT kr%
  317.       '
  318.       msglen.old%=i%
  319.       kr%=0
  320.       '
  321.       WHILE kr%<=msglen.old%
  322.         '
  323.         xx$=CHAR{spot2%+kr%}
  324.         kr%=kr%+LEN(xx$)+1
  325.         '
  326.         IF LEN(xx$)<=79
  327.           IF ASC(xx$)=1
  328.             PRINT #2,"^a"+MID$(xx$,2,4096)
  329.           ELSE IF LEFT$(xx$,8)="SEEN-BY:"
  330.             PRINT #2,"^a"+xx$
  331.           ELSE
  332.             PRINT #2,xx$
  333.           ENDIF
  334.           '
  335.         ELSE
  336.           xx%=RINSTR(xx$," ",79)
  337.           IF xx%=0
  338.             xx%=79
  339.           ENDIF
  340.           WHILE LEN(xx$)>79
  341.             PRINT #2,LEFT$(xx$,xx%)
  342.             xx$=RIGHT$(xx$,LEN(xx$)-xx%)
  343.             xx%=RINSTR(xx$," ",79)
  344.             IF xx%=0
  345.               xx%=79
  346.             ENDIF
  347.           WEND
  348.           '
  349.           IF xx$<>""
  350.             PRINT #2,xx$
  351.           ENDIF
  352.           '
  353.           ' \/ of the byte-by byte analysis
  354.         ENDIF
  355.         '
  356.         ' \/ if there are more bytes in the buffer
  357.       WEND
  358.       '
  359.       msgdropexit:
  360.       ' better give us back the memory!
  361.       '
  362.       IF spot2%
  363.         ~FreeMem(spot2%,msglen%-180)
  364.         spot2%=0
  365.       ENDIF
  366.       IF spotl%
  367.         ~FreeMem(spotl%,msglen%+4)
  368.         spotl%=0
  369.       ENDIF
  370.       PRINT " done!"
  371.     ENDIF
  372.     '
  373.   NEXT k%
  374.   '
  375. ELSE IF sumtype%=3
  376.   '
  377.   PRINT
  378.   PRINT
  379.   FOR k%=lowater% TO hiwater%
  380.     '
  381.     ar$=""
  382.     PRINT k%;".msg";
  383.     PRINT #2,k%;".msg";
  384.     IF NOT EXIST(sourcedir$+STR$(k%)+".MSG")
  385.       PRINT ", does not exist"
  386.       PRINT #2,", does not exist"
  387.     ELSE
  388.       OPEN "I",#6,sourcedir$+STR$(k%)+".MSG",4096
  389.       SEEK #6,190
  390.       '
  391.       aa$=""
  392.       aa&=0
  393.       '
  394.       DO
  395.         xx%=INP(#6)
  396.         aa$=aa$+CHR$(xx%)
  397.         EXIT IF LEN(aa$)>=5
  398.         EXIT IF EOF(#6)
  399.       LOOP
  400.       '
  401.       ' Find AREA: line if there is one...
  402.       '
  403.       IF LEFT$(aa$,4)="AREA"
  404.         WHILE aa&<>13
  405.           aa&=INP(#6)
  406.           ar$=ar$+CHR$(aa&)
  407.         WEND
  408.       ENDIF
  409.       '
  410.       CLOSE #6
  411.       '
  412.       IF LEFT$(ar$,1)=":"
  413.         ar$=RIGHT$(ar$,LEN(ar$)-1)
  414.       ELSE IF ar$=""
  415.         ar$="None"
  416.       ENDIF
  417.       IF RIGHT$(ar$,1)=CHR$(13)
  418.         ar$=LEFT$(ar$,LEN(ar$)-1)
  419.       ENDIF
  420.       PRINT ", AreaTag: ";ar$
  421.       PRINT #2,", AreaTag: ";ar$
  422.     ENDIF
  423.   NEXT k%
  424.   '
  425. ENDIF
  426. '
  427. CLOSE #2
  428. '
  429. finishup:
  430. PRINT ""
  431. PRINT "All done! "+versname$+" exiting..."
  432. ALERT 0,"Exit program",1,"Exit|Quit|Close",xx%
  433. END
  434. '
  435. '
  436. PROCEDURE getwhatshere(msgarea$)
  437.   LOCAL xx%
  438.   '
  439.   lowater%=2100000000
  440.   hiwater%=2
  441.   nummsgs%=0
  442.   '
  443.   DIR msgarea$ TO "RAM:msgdir"
  444.   IF NOT EXIST("RAM:Msgdir")
  445.     hiwater%=0
  446.     lowater%=0
  447.     nummsgs%=0
  448.   ELSE
  449.     OPEN "I",#3,"RAM:msgdir",4096
  450.     nummsgs%=0
  451.     WHILE NOT EOF(#3)
  452.       LINE INPUT #3,xx$
  453.       xx%=VAL(xx$)
  454.       IF xx%>=2
  455.         INC nummsgs%
  456.         '
  457.         IF xx%<lowater%
  458.           lowater%=xx%
  459.         ENDIF
  460.         IF xx%>hiwater%
  461.           hiwater%=xx%
  462.         ENDIF
  463.       ENDIF
  464.       '
  465.     WEND
  466.     CLOSE #3
  467.     '
  468.     ' extra checks to tidy things up from Plutscan
  469.     '
  470.     IF lowater%=2100000000 AND hiwater%=2
  471.       lowater%=0
  472.       hiwater%=0
  473.       nummsgs%=0
  474.     ENDIF
  475.     IF lowater%>hiwater%
  476.       lowater%=hiwater%
  477.     ENDIF
  478.     '
  479.   ENDIF
  480.   '
  481.   IF EXIST("RAM:Msgdir")
  482.     KILL "RAM:MsgDir"
  483.   ENDIF
  484.   '
  485. RETURN
  486. '
  487. '
  488. PROCEDURE spaceout(thing$,col%)
  489.   '
  490.   LOCAL xx%,xq%
  491.   '
  492.   ' [Needs the string to format, and the column width it's going to]
  493.   ' [Returns spc% - the number of spaces required - 1 if field overflow]
  494.   '
  495.   xx%=FRE(1)
  496.   xx%=col%
  497.   xq%=LEN(thing$)
  498.   '
  499.   IF xq%>xx%
  500.     result=1
  501.   ELSE
  502.     result=(xx%-xq%)
  503.   ENDIF
  504.   '
  505.   spc%=result
  506.   '
  507. RETURN
  508. '
  509. '
  510. PROCEDURE header_load
  511.   '
  512.   ' spotl% is the address returned. You must FreeMem(spotl%,msglen%) after
  513.   ' using the data from this function!!!!!!!!
  514.   '
  515.   spotl%=0
  516.   IF EXIST(msghandle$)
  517.     OPEN "I",#7,msghandle$,255
  518.     msglen%=LOF(#7)
  519.     CLOSE #7
  520.     '
  521.     spotl%=AllocMem(msglen%+4,65536)
  522.     '
  523.     IF spotl%=0
  524.       PRINT "Error finding memory - we must be absolutely incredibly low!"
  525.       PRINT "If we haven't got enough room for 1 message, that's it! I'm outahere!"
  526.       END
  527.     ELSE
  528.       '
  529.       xx$=msghandle$+CHR$(0)
  530.       filehand%=Open(V:xx$,1005)
  531.       '
  532.       IF filehand%
  533.         '
  534.         ~Read(filehand%,spotl%,msglen%)
  535.         ~Close(filehand%)
  536.         POKE spotl%+msglen%+1,0
  537.       ENDIF
  538.     ENDIF
  539.   ENDIF
  540.   '
  541. RETURN
  542. '
  543. '
  544. PROCEDURE getmsgdetails(mem%)
  545.   '
  546.   fromname$=CHAR{mem%+0}
  547.   toname$=CHAR{mem%+36}
  548.   subject$=CHAR{mem%+72}
  549.   IF UPPER$(LEFT$(subject$,3))="RE:"
  550.     subject$=TRIM$(MID$(subject$,4,72))
  551.   ENDIF
  552.   dattime$=CHAR{mem%+144}
  553.   '
  554.   timesread&=BCLR(DPEEK(mem%+164),15)
  555.   destnode&=BCLR(DPEEK(mem%+166),15)
  556.   orignode&=BCLR(DPEEK(mem%+168),15)
  557.   cost&=BCLR(DPEEK(mem%+170),15)
  558.   orignet&=BCLR(DPEEK(mem%+172),15)
  559.   destnet&=BCLR(DPEEK(mem%+174),15)
  560.   destzone&=BCLR(DPEEK(mem%+176),15)
  561.   origzone&=BCLR(DPEEK(mem%+178),15)
  562.   destpoint&=BCLR(DPEEK(mem%+180),15)
  563.   origpoint&=BCLR(DPEEK(mem%+182),15)
  564.   replyto&=BCLR(DPEEK(mem%+184),15)
  565.   attribute&=BCLR(DPEEK(mem%+186),15)
  566.   nextreply&=BCLR(DPEEK(mem%+188),15)
  567.   '
  568. RETURN
  569. '
  570.